Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / rpc161a1.arc / RPC-SUB3.BAS < prev next >

Wrap

BASIC Source File | 1988-04-13 | 21.3 KB | 367 lines

****************************************************************************** ************************ RBBS-PC Protocol Controller *** RPC-SUB3.BAS **** ************************ Merge for RBBS-PC.BAS ********************* ************************ By John Morris ******* 16-1A ******* ****************************************************************************** 62530 SUB GETMATTR STATIC Q = SQ B$ = LG$(10) LINES.IN.MESSAGE = LINES.IN.MESSAGE.SAVE S = SL NON.STOP = NON.STOP.SAVE MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX.SAVE KILL.MESSAGE = FALSE END SUB ' $SUBTITLE: 'PROTOCOL - check for external protocols' ' $PAGE ' ' SUBROUTINE NAME -- PROTOCOL ' ' PARAMETER MEANING ' ' INPUT PARAMETERS -- NONE ' ' OUTPUT PARAMETERS -- TRANSFER.OPTIONS$ FILE TRANSFER PROTOCOLS ' THAT ARE ALLOWED. ' DFLTXFER$ THE STRING FROM WHICH ' PROTOCOLS ARE SELECTED ' (USING 'INSTR') ' SELECT.CHAR$() PROT.STRNG$ IS BUILT FROM ' THESE CHARACTERS ' PROT.NAME$() PROTOCOL NAME FOR EACH ' PROTOCOL ' UPLOAD.BAT.FILE.NAME$() BATCH FILE USED TO UPLOAD ' FOR EACH PROTOCOL ' DOWNLOAD.BAT.FILE.NAME$() BATCH FILE USED TO DOWNLOAD ' FOR EACH PROTOCOL ' RUN.METHOD$() DETERMINES WHETHER TO USE ' THE SHELL OR EXIT-RBBS ' METHOD FOR EACH PROTOCOL ' SUCCESS.CHECK.METHOD$() WAY TO CHECK EACH TRANSFER ' FOR SUCCESS ' MODE$() DIFFERENT OPTIONS OR CONTROLS ' NEEDED FOR EACH PROTOCOL ' =1 RELIABLE.MODE NEEDED ' =2 DON'T PRINT # OF BLOCKS ' =3 BATCH TRANSFER ALLOWED ' =4 MODE 2 + ALLOW ' BATCH TRANSFER ' =5 MODE 2 + WRITE FAKE ' XFER REPORT ' =6 (NOT USED) ' =7 (NOT USED) ' =8 1k BLOCKS ' =9 MODE 1 + 1k BLOCKS ' ' SUBROUTINE PURPOSE -- TO DETERMINE WHICH EXTERNAL PROTOCOL'S ARE AVAILABLE ' AND BUILD TRANSFER.OPTION$ AND SEVERAL ARRAYS ' ACCORDINGLY ' * ------[ first line different ]------ SUB PROTOCOL STATIC ' RPC16-1A CLOSE 2 ' RPC16-1A CALL OPENWORK("RBBSXFR" + NODE.ID$ + ".DEF") ' RPC16-1A ' RPC16-1A PROTNUM = 2 ' RPC16-1A DFLTXFER$ = "A" ' RPC16-1A PROT.NAME$(1) = "Ascii" ' RPC16-1A TRANSFER.OPTIONS$ = "A) Ascii, " ' RPC16-1A IF NOT USE.EXTERNAL.XMODEM THEN _ ' RPC16-1A PROT.NAME$(2) = "Xmodem" : _ ' RPC16-1A PROT.NAME$(3) = "Xmodem/CRC" : _ ' RPC16-1A TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + _ ' RPC16-1A "X) Xmodem, " + _ ' RPC16-1A "C) Xmodem/CRC, " : _ ' RPC16-1A DFLTXFER$ = DFLTXFER$ + "XC" : _ ' RPC16-1A PROTNUM = 4 ' RPC16-1A IF NOT USE.EXTERNAL.YMODEM THEN _ ' RPC16-1A PROT.NAME$(4) = "Ymodem" : _ ' RPC16-1A TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + _ ' RPC16-1A "Y) Ymodem, " : _ ' RPC16-1A DFLTXFER$ = DFLTXFER$ + "Y" : _ ' RPC16-1A PROTNUM = 5 ' RPC16-1A WHILE NOT EOF(2) ' RPC16-1A INPUT #2, SELECT.CHAR$(PROTNUM), _ ' RPC16-1A PROT.NAME$(PROTNUM), _ ' RPC16-1A UPLOAD.BAT.FILE.NAME$(PROTNUM), _ ' RPC16-1A DOWNLOAD.BAT.FILE.NAME$(PROTNUM), _ ' RPC16-1A RUN.METHOD$(PROTNUM), _ ' RPC16-1A SUCCESS.CHECK.METHOD$(PROTNUM), _ ' RPC16-1A MODE$(PROTNUM) ' RPC16-1A IF INSTR("19",MODE$(PROTNUM)) AND NOT RELIABLE.MODE THEN GOTO 62610 IF (PROTNUM MOD 6) = 0 THEN _ ' RPC16-1A TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + RETURN.LINE.FEED$ TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + SELECT.CHAR$(PROTNUM) + _ ") " + PROT.NAME$(PROTNUM) + ", " ' RPC16-1A DFLTXFER$ = DFLTXFER$ + SELECT.CHAR$(PROTNUM) ' RPC16-1A IF INSTR(UPLOAD.BAT.FILE.NAME$(PROTNUM),".") = 0 THEN _ ' RPC16-1A UPLOAD.BAT.FILE.NAME$(PROTNUM) = UPLOAD.BAT.FILE.NAME$(PROTNUM) + _ ".BAT" ' RPC16-1A IF INSTR(DOWNLOAD.BAT.FILE.NAME$(PROTNUM),".") = 0 THEN _ ' RPC16-1A DOWNLOAD.BAT.FILE.NAME$(PROTNUM) = DOWNLOAD.BAT.FILE.NAME$(PROTNUM) + _ ".BAT" ' RPC16-1A PROTNUM = PROTNUM + 1 ' RPC16-1A * DELETING old line(s) 62600 * INSERTING new line(s) 62610 WEND ' RPC16-1A CLOSE 2 ' RPC16-1A LAST.PROT.NUM = PROTNUM ' RPC16-1A END SUB ' RPC16-1A ' $SUBTITLE: 'TRANSFER - subroutine for KERMIT, YMODEM, IMODEM & YMODEM' ' $PAGE ' ' SUBROUTINE NAME -- TRANSFER ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TRANSFER.FUNCTION = 1 DOWNLOAD FILE TO USER ' = 2 UPLOAD FILE TO RBBS-PC ' FILE.NAME$ NAME OF FILE FOR TRANSFER ' COM.PORT$ NAME OF COMMUNICATIONS PORT ' TO BE USED BY KERMIT (COM1 ' OR COM2) ' BPS = -1 FOR 300 BAUD ' = -2 FOR 450 BAUD ' = -3 FOR 1200 BAUD ' = -4 FOR 2400 BAUD ' = -5 FOR 4800 BAUD ' = -6 FOR 9600 BAUD ' = -7 FOR 19200 BAUD ' PCKERMIT.EXE.FILE$ FILE TO TRANSFER CONTROL TO ' FOR KERMIT PROTOCOL ON ' PROTOCOL.PATH$. ' QMXFER.COM.FILE$ FILE TO TRANSFER CONTROL TO ' FOR YMODEM, IMODEM OR ' YMODEMG PROTOCOLS. ' WXMODEM.COM.FILE$ FILE TO TRANSFER CONTROL TO ' FOR WXMODEM PROTOCOL ON ' PROTOCOL.PATH$ ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO TRANSFER FILES USING KERMIT, YMODEM, IMODEM, ' YMODEMG OR WXMODEM PROTOCOL'S ' * REPLACING old line(s) by new 62620 SUB TRANSFER STATIC * ------[ first line different ]------ IF NOT PRIVATE.DOOR THEN _ ' RPC16-1A IF TRANSFER.FUNCTION = 1 THEN _ ' RPC16-1A XFER.FILE$ = DOWNLOAD.BAT.FILE.NAME$(FF) : _ ' RPC16-1A B$ = " send of " _ ' RPC16-1A ELSE XFER.FILE$ = UPLOAD.BAT.FILE.NAME$(FF) : _ ' RPC16-1A B$ = " receive of " ' RPC16-1A CALL QTPUT (PROT.NAME$(FF) + B$ + FILE.NAME.HOLD$ + " ready! <Ctrl X> Aborts",1) CALL XFRETURN ' RPC16-1A END SUB ' RPC16-1A ' $SUBTITLE: 'XFRETURN - subroutine to exit as a private door.' ' $PAGE ' ' SUBROUTINE NAME -- XFRETURN ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TRANSFER.FUNCTION = 1 DOWNLOAD FILE TO USER ' = 2 UPLOAD FILE TO RBBS-PC ' = 3 USER REGISTRATION PGM ' B$ NAME OF FILE TO EXIT TO ' COM.PORT$ NAME OF COMMUNICATIONS PORT ' TO BE USED BY KERMIT (COM1 ' OR COM2) ' BPS = -1 FOR 300 BAUD ' = -2 FOR 450 BAUD ' = -3 FOR 1200 BAUD ' = -4 FOR 2400 BAUD ' = -5 FOR 4800 BAUD ' = -6 FOR 9600 BAUD ' = -7 FOR 19200 BAUD ' QMXFER.COM.FILE$ FILE TO TRANSFER CONTROL TO ' FOR YMODEM, IMODEM OR ' YMODEMG PROTOCOLS. ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO TRANSFER CONTROL TO ANOTHER PROGRAM ' SUB XFRETURN STATIC EXEC.METHOD$ = RUN.METHOD$(FF) ' RPC16-1A IF PRIVATE.DOOR THEN _ ' RPC16-1A EXEC.METHOD$ = "N" ' RPC16-1A IF NOT PRIVATE.DOOR THEN _ ' RPC16-1A FAKERPTTYPE$ = MID$(DFLTXFER$,FF,1) : _ ' RPC16-1A IF MODE$(FF) = "5" THEN _ ' RPC16-1A CALL FAKEXRPT(FAKERPTTYPE$) ' RPC16-1A IF EXEC.METHOD$ = "D" THEN _ ' RPC16-1A CALL MODXFERSTRING(XFER.FILE$,SHELL.STRING$) : _ ' RPC16-1A CLOSE 3 : _ ' RPC16-1A OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1 : _ ' RPC16-1A CALL DELAYIT(2) : _ ' RPC16-1A DEF SEG = 0 : _ ' RPC16-1A FOR X = 0 TO 7 : _ ' RPC16-1A COM.PORT.ADDRESS(X) = PEEK(&H400 + X) : _ ' RPC16-1A NEXT : _ ' RPC16-1A DEF SEG : _ ' RPC16-1A SHELL SHELL.STRING$ : _ ' RPC16-1A CALL DELAYIT(2) : _ ' RPC16-1A DEF SEG = 0 : _ ' RPC16-1A FOR X = 0 TO 7 : _ ' RPC16-1A POKE (&H400 + X), COM.PORT.ADDRESS(X) : _ ' RPC16-1A NEXT : _ ' RPC16-1A DEF SEG ' RPC16-1A IF EXEC.METHOD$ = "E" THEN _ ' RPC16-1A A$(1) = "COMMAND /C " + _ ' RPC16-1A XFER.FILE$ + " " + _ ' RPC16-1A TALK.TO.MODEM.AT$ + " " + _ ' RPC16-1A RIGHT$(COM.PORT$,1) + " " + _ ' RPC16-1A FILE.NAME$ + " " + _ ' RPC16-1A MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$,",") + 1,1) : _ ' RPC16-1A A$(2) = RBBS.BAT$ : _ ' RPC16-1A PRIVATE.DOOR = -1 : _ ' RPC16-1A CALL QTPUT ("Exiting to External Program. BEGIN TRANSFER and Please be patient.",1) : _ LOCATE 25,1 : _ ' RPC16-1A CALL LPRNT(CHR$(10),0) : _ ' RPC16-1A CALL MEMORY(FF) : _ ' RPC16-1A CALL RBBSEXIT(A$(),2) ' RPC16-1A CALL LINE25 ' RPC16-1A PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6) ' RPC16-1A IF NOT LOCAL.USER THEN _ ' RPC16-1A CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$) : _ ' RPC16-1A IF PRIVATE.DOOR THEN _ ' RPC16-1A FOR X = 1 TO 20 : _ ' RPC16-1A PRINT : _ ' RPC16-1A NEXT X : _ ' RPC16-1A CALL QTPUT ("Reloading RBBS-PC. Please be patient.",1) : _'RPC16-1A CALL DELAYIT(2) : _ ' RPC16-1A CALL REMEMBER(FF) ' RPC16-1A CALL SKIPLINE(2) ' RPC16-1A LOCATE 24,1 ' RPC16-1A IF TRANSFER.FUNCTION = 2 THEN : _ ' RPC16-1A CLS : _ ' RPC16-1A CALL LINE25 ' RPC16-1A * DELETING old line(s) 62622 62624 62626 62628 62629 62630 62631 * REPLACING old line(s) by new 62632 END SUB * ------[ first line different ]------ ' $SUBITLE: 'MODXFERSTRING - Modify string in .BAT file' ' $PAGE ' ' SUBROUTINE NAME -- MODXFERSTRING ' ' PARAMETER MEANING ' ' INPUT PARAMETERS -- XFERBATFILE$ .BAT FILE TO GET INFO ' FROM ' OUTPUT PARAMETERS -- SHELL.STRING$ STRING TO USE FOR SHELL ' METHOD ' ' SUBROUTINE PURPOSE -- TO OPEN A BATCH AND RETRIEVE THE STRING TO USE FOR ' THE SHELL METHOD OF TRANSFER FROM WITHIN RBBS-PC. ' THIS IS THE SAME BATCH FILE USED WHEN USING THE ' EXIT RBBS-PC METHOD OF TRANSFER ' * INSERTING new line(s) 62640 SUB MODXFERSTRING(XFERBATFILE$,SHELL.STRING$) STATIC ' RPC16-1A CLOSE 2 ' RPC16-1A OPEN XFERBATFILE$ FOR INPUT AS #2 ' RPC16-1A LINE INPUT #2, DUMMY$ ' RPC16-1A LINE INPUT #2, STRING.TO.CHANGE$ ' RPC16-1A CLOSE 2 ' RPC16-1A BAUD.STRING$ = TALK.TO.MODEM.AT$ ' RPC16-1A MODEM.PORT$ = RIGHT$(COM.PORT$,1) ' RPC16-1A PARITY$ = MID$("NE",2 + 1 * EIGHT.BIT,1) ' RPC16-1A BAUD.IN.STRING = INSTR(STRING.TO.CHANGE$,"%1") ' RPC16-1A STRING1$ = MID$(STRING.TO.CHANGE$,1,BAUD.IN.STRING-1) ' RPC16-1A STRING2$ = MID$(STRING.TO.CHANGE$,BAUD.IN.STRING + 2) ' RPC16-1A STRING.TO.CHANGE$ = STRING1$ + BAUD.STRING$ + STRING2$ ' RPC16-1A PORT.IN.STRING = INSTR(STRING.TO.CHANGE$,"%2") ' RPC16-1A STRING1$ = MID$(STRING.TO.CHANGE$,1,PORT.IN.STRING-1) ' RPC16-1A STRING2$ = MID$(STRING.TO.CHANGE$,PORT.IN.STRING + 2) ' RPC16-1A STRING.TO.CHANGE$ = STRING1$ + MODEM.PORT$ + STRING2$ ' RPC16-1A FILE.IN.STRING = INSTR(STRING.TO.CHANGE$,"%3") ' RPC16-1A STRING1$ = MID$(STRING.TO.CHANGE$,1,FILE.IN.STRING-1) ' RPC16-1A STRING2$ = MID$(STRING.TO.CHANGE$,FILE.IN.STRING + 2) ' RPC16-1A STRING.TO.CHANGE$ = STRING1$ + FILE.NAME$ + STRING2$ ' RPC16-1A PRTY.IN.STRING = INSTR(STRING.TO.CHANGE$,"%4") ' RPC16-1A IF PRTY.IN.STRING > 0 THEN _ ' RPC16-1A STRING1$ = MID$(STRING.TO.CHANGE$,1,PRTY.IN.STRING-1) : _ ' RPC16-1A STRING2$ = MID$(STRING.TO.CHANGE$,PRTY.IN.STRING + 2) : _ ' RPC16-1A STRING.TO.CHANGE$ = STRING1$ + PARITY$ + STRING2$ ' RPC16-1A NODE.IN.STRING = INSTR(STRING.TO.CHANGE$,"%5") ' RPC16-1A IF NODE.IN.STRING > 0 THEN _ ' RPC16-1A STRING1$ = MID$(STRING.TO.CHANGE$,1,NODE.IN.STRING-1) : _ ' RPC16-1A STRING2$ = MID$(STRING.TO.CHANGE$,NODE.IN.STRING + 2) : _ ' RPC16-1A STRING.TO.CHANGE$ = STRING1$ + NODE.ID$ + STRING2$ ' RPC16-1A SHELL.STRING$ = STRING.TO.CHANGE$ ' RPC16-1A END SUB ' RPC16-1A ' $SUBTITLE: 'MEMORY - "Memorize" FF before exiting RBBS-PC' ' $PAGE ' ' SUBROUTINE NAME -- MEMORY ' ' PARAMETER MEANING ' ' INPUT PARAMETERS -- FF NUMBER OF PROTOCOL USED ' FOR THIS TRANSFER ' OUTPUT PARAMETERS -- NONE ' ' ' SUBROUTINE PURPOSE -- WRITE "FF" TO A FILE SO IT CAN BE RETRIEVED AFTER ' USING THE EXIT RBBS-PC METHOD OF XFER THIS IS NEEDED ' FOR ANY NON-QMXFER TYPE OF PROTOCOL DRIVER ' SUB MEMORY(FF) STATIC ' RPC16-1A CLOSE 2 ' RPC16-1A OPEN "XFER-" + NODE.ID$ + ".TMP" FOR OUTPUT AS #2 ' RPC16-1A PRINT #2, FF ' RPC16-1A PRINT #2, FILE.NAME$ ' RPC16-1A PRINT #2, FILE.NAME.HOLD$ ' RPC16-1A CLOSE 2 ' RPC16-1A END SUB ' RPC16-1A ' $SUBTITLE: 'REMEMBER - Retrive FF after re-entering RBBS-PC' ' $PAGE ' ' SUBROUTINE NAME -- REMEMBER ' ' PARAMETER MEANING ' ' INPUT PARAMETERS -- NONE ' ' OUTPUT PARAMETERS -- FF NUMBER OF PROTOCOL USED ' FOR THE LAST TRANSFER ' ' SUBROUTINE PURPOSE -- RETRIVE "FF" FROM A FILE SO IT CAN BE USED AFTER ' RE-ENTERING RBBS-PC. THIS IS NEEDED FOR ANY ' NON-QMXFER TYPE OF PROTOCOL DRIVER ' SUB REMEMBER(FF) STATIC ' RPC16-1A CLOSE 2 ' RPC16-1A CALL OPENWORK ("XFER-" + NODE.ID$ + ".TMP") ' RPC16-1A INPUT #2, FF ' RPC16-1A INPUT #2, FILE.NAME$ ' RPC16-1A INPUT #2, FILE.NAME.HOLD$ ' RPC16-1A CLOSE 2 ' RPC16-1A END SUB ' RPC16-1A ' $SUBTITLE: 'FAKEXRPT - subroutine to create fake xfer report' ' $PAGE ' ' SUBROUTINE NAME -- FAKEXRPT ' ' INPUT PARAMETERS -- PARAMETER MEANING ' FILE.NAME.HOLD$ FILE TO BE TRANSFERRED ' PROTO.USED$ PROTOCOL USED ' ' OUTPUT PARAMETERS -- WRITES OUT TRANSFER FILE REPORT ' ' SUBROUTINE PURPOSE -- EXTERNAL PROTOCOL DRIVERS THAT DO NOT WRITE ' OUT A STANDARD TRANSFER REPORT MUST HAVE ONE ' PROVIDED IN ORDER FOR "DOORING" TO EXTERNAL ' PROTOCOLS TO WORK PROPERLY, SINCE THIS FILE ' IS READ UPON RETURNING FROM AN EXTERNAL PROTOCOL. '